home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr13 / pgnat102.zip / PAGINATE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-24  |  5KB  |  158 lines
  1. PROGRAM PaginateTextFiles;
  2. {------------------------------------------------------------------------------
  3.  
  4.                                 REVISION HISTORY
  5.  
  6. v1.00 : 1993/07/14.  First public release.  DDA
  7. v1.01 : 1993/10/22.  Now removes existing page breaks automatically.  DDA
  8. v1.02 : 1995/02/24.  Now handles files longer than 65535 pages.  DDA
  9.                      Changed parameter specification.  DDA
  10.                      Improved error handling.  DDA
  11.  
  12. ------------------------------------------------------------------------------}
  13.  
  14. USES Dos;
  15. const
  16.   progdesc = 'Paginate v1.02 - Free DOS utility: text file paginator.';
  17.  
  18. VAR SavedExitProc: Pointer;
  19.  
  20. procedure CustomExit; far;
  21. {---- Always exit through here ----}
  22. const
  23.   author   = 'February 24, 1995. Copyright (c) 1995 by David Daniel Anderson - Reign Ware.';
  24.   usage    = 'Usage:    Paginate <infile> <outfile> ##[:##]';
  25.   where    = 'Where:    ##[:##]  = lines per ODD:EVEN pages.  If not specified, EVEN=ODD.';
  26.   example  = 'Example:  Paginate draft.txt paged.doc 55:50';
  27. var
  28.   message: string[79];
  29. begin
  30.   ExitProc := SavedExitProc;
  31.   if (ExitCode > 0) then begin
  32.     writeln(progdesc);
  33.     writeln(author);    writeln;
  34.     writeln(usage);
  35.     writeln(where);     writeln;
  36.     writeln(example);   writeln;
  37.   end;
  38.   if ErrorAddr <> nil then
  39.   begin
  40.     writeln('An unanticipated error occurred, please contact DDA with the following data:');
  41.     writeln('Address = ', Seg(ErrorAddr^), ':', Ofs(ErrorAddr^));
  42.     writeln('Code    = ', Exitcode);
  43.     ErrorAddr := nil;
  44.   end
  45.   else
  46.     if (ExitCode > 0) and (ExitCode < 255) then begin
  47.        case ExitCode of
  48.          2 : Message := 'Wildcard characters (*,?) are not allowed in any parameter.';
  49.          3 : Message := 'Input file "'+ParamStr(1)+'" doesn''t exist or cannot be opened.';
  50.          4 : Message := 'Output file "'+ParamStr(2)+'" already exists or cannot be written to.';
  51.          5 : Message := 'Non-numeric found in line specification: '+ParamStr(3);
  52.        else  message := 'Unknown error.';
  53.        end;
  54.        writeln (#7, 'Error encountered, number ',ExitCode,':'); writeln (message);
  55.     end;
  56. end;
  57.  
  58. function fileexists(const filename:pathstr): boolean;
  59. var
  60.   attr: word;
  61.   f   : file;
  62. begin
  63.   assign(f, filename);
  64.   getfattr(f, attr);
  65.   fileexists := (DOSerror = 0);
  66. end;
  67.  
  68. procedure ParseCommandLine(var infile, outfile: text; var odd, even: word);
  69. var count: byte;  VErr: integer;
  70.     oddstr, evenstr: string[7];
  71.  
  72. begin
  73.   if ParamCount <> 3 then halt(255);
  74.   for count := 1 to 3 do
  75.     if (Pos('*',ParamStr(count)) > 0) or (Pos('?',ParamStr(count)) > 0)
  76.       then halt(2);
  77.   oddstr := ParamStr(3);
  78.   if Pos(':', oddstr) > 0 then
  79.     begin
  80.       evenstr := Copy(oddstr,1+Pos(':',oddstr), Length(oddstr)-Pos(':',oddstr));
  81.       oddstr := Copy(oddstr,1,Pos(':',oddstr)-1);
  82.     end
  83.     else
  84.       evenstr := oddstr;
  85.  
  86.   Val(oddstr, odd, VErr); if VErr <> 0 then halt(5);
  87.   Val(evenstr, even, VErr); if VErr <> 0 then halt(5);
  88.  
  89.   if NOT fileexists(ParamStr(1)) then halt(3)
  90.     else begin
  91.       assign(infile, ParamStr(1));
  92.       reset(infile); if (IOResult <> 0) then halt(3);
  93.     end;
  94.  
  95.   if fileexists(ParamStr(2)) then halt(4)
  96.     else begin
  97.       assign(outfile, ParamStr(2));
  98.       rewrite(outfile); if (IOResult <> 0) then halt(4);
  99.     end;
  100.  
  101.   Writeln(progdesc);
  102.   Writeln('Paginate is processing your data, specified as follows:');
  103.   Writeln('Input (unpaged) file = ',ParamStr(1));
  104.   Writeln('Output (paged) file  = ',ParamStr(2));
  105.   Writeln('Lines per odd page   = ',Odd);
  106.   Writeln('Lines per even page  = ',Even);
  107. end;
  108.  
  109. procedure InsertFF(var infile, outfile: text; var oddLines, evenLines: word);
  110. CONST
  111.   FF = #12;  { the page break character }
  112. VAR
  113.   PageCopying,
  114.   LinesCopied   : LongInt;
  115.   LinesPerPage,
  116.   LinesThisPage : Word;
  117.   CurrLine      : String;
  118. BEGIN
  119.   PageCopying := 1;
  120.   LinesCopied := 0;
  121.   LinesPerPage := OddLines;
  122.   LinesThisPage := 0;
  123.   WHILE (NOT Eof(InFile)) DO
  124.   BEGIN
  125.     ReadLn(InFile,CurrLine);
  126.     WHILE ((Pos(FF,CurrLine)) > 0) do delete(CurrLine,(pos(FF,CurrLine)),1);
  127.     IF (LinesThisPage = LinesPerPage) THEN
  128.     BEGIN
  129.       CurrLine := FF + CurrLine;
  130.       LinesThisPage := 0;
  131.       Inc(PageCopying);
  132.       IF ((PageCopying MOD 2) = 0) THEN
  133.         LinesPerPage := EvenLines
  134.       ELSE
  135.         LinesPerPage := OddLines;
  136.     END;
  137.     WriteLn(OutFile,CurrLine);
  138.     Inc(LinesThisPage);
  139.     Inc(LinesCopied);
  140.   END;
  141.   Close(InFile);
  142.   Close(OutFile);
  143.   Write('Paginate created ',PageCopying,' pages out of ',LinesCopied);
  144.   Writeln(' lines, the final page has ',LinesThisPage,' lines.');
  145. END;
  146.  
  147. VAR
  148.   InFile, OutFile: Text;
  149.   OddLines, EvenLines: Word;
  150.  
  151. BEGIN  { main }
  152.   SavedExitProc := ExitProc;
  153.   ExitProc := @CustomExit;
  154.  
  155.   ParseCommandLine(InFile, OutFile, OddLines, EvenLines);
  156.   InsertFF(InFile, OutFile, OddLines, EvenLines);
  157. END.
  158.